Developer CD Series 1995 February: Tool Chest/Dev.CD Feb 95/Dev.CD Feb 95.toast/Sample Code/Pascal Sample 3.0B10/Source/TrafficLights.inc1.p

Text File | 1993-10-13 | 86.2 KB | 2,508 lines | [TEXT/MPS ]

(******************************************************************************
*
*    Apple Macintosh Developer Technical Support
*
*    Code for the traffic lights
*
*    Program:    Sample 3.0
*    File:        TrafficLights.inc1.p - Pascal implementation
*
*    by:            Matt Deatherage
*
*    Copyright © 1988-1993 Apple Computer, Inc.
*    All rights reserved.
*
******************************************************************************)

(*******************************************************************************
* Global variables maintained by this unit that are private to routines in it
*******************************************************************************)

VAR

    gLastRectClicked: INTEGER;            { number of the last rectangle we clicked
                                          in this window (used for double-click
                                          testing) }
    gLastWindowClicked: WindowPtr;         { pointer to the window we last clicked
                                          in (used for double-click testing) }
    gLastClickedTime: LONGINT;             { time stamp of the last click (used for
                                          double-click testing) }

(*******************************************************************************
* Routines in other files referenced by this code
*******************************************************************************)

FUNCTION Print(thePrRecHdl: THPrint; theWindow: WindowPtr; thePict: PicHandle;
               theMergeRec: THPrint): BOOLEAN;
    EXTERNAL;

FUNCTION PageSetup(thePrRecHdl: THPrint): BOOLEAN;
    EXTERNAL;

FUNCTION DoCircleOptions(VAR circle: CircleRec): BOOLEAN;
    EXTERNAL;

{$S Main}
(******************************************************************************
*
* Public: DoPageSetup
*
* This is a "shell" function, called by Sample.p so that it doesn't have
* to know how to extract print records from our documents.  This quickly
* extracts the print record and passes it to PageSetup in the PrintStuff unit.
*
******************************************************************************)

FUNCTION DoPageSetup(theWindow: WindowPtr): BOOLEAN;

VAR
    theDoc: DocumentPtr;        { the document for the window }

BEGIN
    theDoc := DocumentPtr(GetWRefCon(theWindow));
    DoPageSetup := PageSetup(theDoc^.printRecord);
END; { DoPageSetup }

{$S Main}
(******************************************************************************
*
* Public: DoPrint
*
* This is a "shell" function, called by Sample.p so that it doesn't have
* to know how to extract print records from our documents.  This quickly
* extracts the print record and passes it to Print in the PrintStuff unit.
* We pass the window to draw instead, though I suppose we could just
* call MakeDocumentPicture and pass a PICT Handle.
*
******************************************************************************)

FUNCTION DoPrint(theWindow: WindowPtr): BOOLEAN;

VAR
    theDoc: DocumentPtr;        { the document for the window }

BEGIN
    theDoc := DocumentPtr(GetWRefCon(theWindow));
    DoPrint := Print(theDoc^.printRecord, theWindow, NIL, NIL);
END; { DoPrint }

{$S Main}
(******************************************************************************
*
* private: DisposeDocument
*
* This routine closes a file associated with the document, if one is open,
* and then releases all memory associated with the document.  It returns
* FALSE if, for some reason the document couldn't be disposed.
*
******************************************************************************)

FUNCTION DisposeDocument(theDoc: DocumentPtr): BOOLEAN;

VAR
    myErr: OSErr;                { any error from closing the file }

BEGIN
    myErr := noErr;
    IF theDoc^.ourFileRefNum <> 0 THEN
        BEGIN
            myErr := FSClose(theDoc^.ourFileRefNum);
            IF myErr <> noErr THEN
                HandleFileError(myErr, theDoc^.ourFile.name);
        END;
    IF myErr = noErr THEN
        BEGIN
            DisposeHandle(Handle(theDoc^.printRecord));
            DisposePtr(Ptr(theDoc));
            DisposeDocument := TRUE;
        END
    ELSE
        DisposeDocument := FALSE;
END; { DisposeDocument }

{$S Main}
(******************************************************************************
*
* Public: DoPrintFile
*
* This procedure gets a document from a reference disk file, prints it and
* disposes of it.
*
******************************************************************************)

PROCEDURE DoPrintFile(theFile: FileLikeSpecPtr; theMergePrintRecord: THPrint);

VAR
    theDoc: DocumentPtr;        { the document we Create in memory }
    ignore: BOOLEAN;            { ignored result of two routines we call }
    thePict: PicHandle;            { the Picture we print }

BEGIN
    theDoc := MakeEmptyDoc;
    IF GetDocumentFromFile(theFile, theDoc) THEN
        BEGIN
            thePict := MakeDocumentPicture(theDoc);
            ignore := Print(theDoc^.printRecord, NIL,
                            thePict, theMergePrintRecord);
            KillPicture(thePict);
            ignore := DisposeDocument(theDoc);
        END;
END; { DoPrintFile }

{$S Main}
(******************************************************************************
*
* Public: GetDocumentDirtyFlag
*
* A simple getter function -- returns a document structure's dirty flag.
*
*
******************************************************************************)

FUNCTION GetDocumentDirtyFlag(theDoc: DocumentPtr): INTEGER;

BEGIN
    GetDocumentDirtyFlag := theDoc^.dirtyFlag;
END; { GetDocumentDirtyFlag }

{$S Main}
(******************************************************************************
*
* Public: SetDocumentDirtyFlag
*
* A simple setter function -- sets a document structure's dirty flag.
*
*
******************************************************************************)

PROCEDURE SetDocumentDirtyFlag(theDoc: DocumentPtr; theFlag: INTEGER);

BEGIN
    theDoc^.dirtyFlag := theFlag;
END; { SetDocumentDirtyFlag }

{ GetDocumentDiskSize returns a LONGINT that says how many bytes our document takes }
{ as stored on disk. }

{$S Main}
(******************************************************************************
*
* private: GetDocumentDiskSize
*
* This routine returns the size of a document structure on disk.  It's the
* size of each CircleRec times the number of circles in the document, plus
* a print record, plus four integers -- the circle count, the active circle,
* the circle inset and the internal file version word that we use to see
* if some later version of this program created this file.
*
* Note that if the file format changes, you have to change this routine,
* PutDocumentToFile and GetDocumentFromFile.
*
******************************************************************************)

FUNCTION GetDocumentDiskSize(theDoc: DocumentPtr): LONGINT;

BEGIN
    GetDocumentDiskSize := (sizeof(CircleRec) * theDoc^.numCircles) +
                           sizeof(TPrint) + (4 * sizeof(INTEGER));
END; { GetDocumentDiskSize }

{$S Main}
(******************************************************************************
*
* private: PutDocumentToFileGuts
*
* This routine takes a document structure pointer and writes the document
* to a file on disk.  Even though each document contains a FileLikeSpec,
* we check only the file reference number.  If it's zero, the file's never
* been saved to disk, so we call the Standard file Package to find a place
* to put the file.  We turn the working directory information in the SFReply
* record into a real vRefNum and dirID, then use HOpen to open the file.
* If that returns a file not found error, we try to Create the file and,
* if that succeeds, try once again to open it.  Failure results in no
* save and an Alert to the user.  For new files, we then include the
* application name 'STR ' resource, so the System 7 Finder can tell users
* what application they need if they don't have it.
*
* At that Point, we have a good file specification or the user canceled,
* in which case we set myErr to userCanceledErr to indicate something
* went wrong.
*
* The second half of the routine writes the document to disk, one piece
* at a time.  If there's no error from the early part, we set the file
* position to zero in preparation for writing (redundant if it's a new
* file, not redundant if it's not).  Checking for errors after each step,
* we then truncate the file to the size it will have just to be thorough.
* Then we write the internal file version, the number of circles, the
* active circle number and the circle inset.  Then follows the print
* record, and then the array of circles.  After that, we flush the
* file to make sure it's all written to disk properly.
*
* Note that if the file format changes, you have to change this routine,
* GetDocumentDiskSize and GetDocumentFromFileGuts.
*
* This routine is a guts routine -- it's called from PutDocumentToFile
* (below).  This routine returns any time it encounters an error, after
* appropriate clean-up.  Not to do it this way requires so many levels
* of "IF myErr = noErr THEN" that it becomes almost unreadable.
*
******************************************************************************)

PROCEDURE PutDocumentToFileGuts(theDoc: DocumentPtr; VAR myErr : OSErr);

VAR
    where: Point;                    { location of Standard file dialog }
    myReply: SFReply;                { contains user's Standard file choices }
    theVRefNum: INTEGER;            { vRefNum of the volume we're writing to }
    theDirID: LONGINT;                { directory ID of the file's parent dir }
    procID: LONGINT;                { used in GetWDInfo; ignored by us }
    fileVersion: INTEGER;            { variable to hold the file version const }
    counter: INTEGER;                { loop counter variable }
    myPB: ParamBlockRec;            { parameter block for the Flush call }
    transferCount: LONGINT;            { how many bytes we wrote to disk }
    ourResFileRefNum: INTEGER;        { resource file number of the disk file }
    promptString: Str255;            { String to use as prompt in Std file box }

BEGIN

    myErr := noErr;             { start assuming no error }
    WITH theDoc^ DO
        BEGIN
            IF ourFileRefNum = 0 THEN { is there an open file already? }
                BEGIN
                    where.h := 50; { initialize our Point }
                    where.v := 50;
                    GetIndString(promptString, rMiscStrings, kSaveFileAs);
                    SFPutFile(where, promptString, ourFile.name, NIL, myReply);
                    IF NOT myReply.good THEN
                        BEGIN
                            myErr := userCanceledErr;
                            Exit(PutDocumentToFileGuts);
                        END;

                    procID := 0;

                    { turn Standard file's working directory into a real vRefNum
                      and dirID }

                    myErr := GetWDInfo(myReply.vRefNum, theVRefNum, theDirID, procID);

                    IF (myErr <> noErr) THEN
                        Exit(PutDocumentToFileGuts);

                    { open the file.  If we can't open it because it's not
                      found, try to Create it and then try to open it again. }

                    myErr := HOpen(theVRefNum, theDirID, myReply.fName, fsRdWrPerm,
                                   ourFileRefNum);
                    IF myErr = fnfErr THEN { file not found? }
                        BEGIN
                            myErr := HCreate(theVRefNum, theDirID, myReply.fName,
                                              kOurCreatorType, kOurDocumentType);
                            IF myErr = noErr THEN         { did we Create the file ok? }
                                myErr := HOpen(theVRefNum, theDirID, myReply.fName,
                                               fsRdWrPerm, ourFileRefNum);
                        END     { if file not found }
                    ELSE
                        Exit(PutDocumentToFileGuts);

                    { all is good; save info in our FileLikeSpec }

                    ourFile.name := myReply.fName;
                    ourFile.parID := theDirID;
                    ourFile.vRefNum := theVRefNum;

                    { add application name resource to the new file }

                    HCreateResFile(theVRefNum, theDirID, myReply.fName);
                    ourResFileRefNum := HOpenResFile(theVRefNum, theDirID,
                                                     myReply.fName, fsRdWrPerm);
                                                     { this shouldn't fail }
                    myErr := ResError;
                    IF myErr = noErr THEN
                        myErr := DoCopyResource('STR ', kMissingAppNameStr,
                                                gAppsResourceFile, ourResFileRefNum);
                    CloseResFile(ourResFileRefNum);
                END;                            { if ourFileRefNum was zero }

            { we should have a good file open by this Point }

            myErr := SetFPos(ourFileRefNum, fsFromStart, 0); { Move to start of file }
            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            myErr := SetEOF(ourFileRefNum, GetDocumentDiskSize(theDoc));
            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            transferCount := sizeof(INTEGER);
            fileVersion := kFileInternalVersion;
            myErr := FSWrite(ourFileRefNum, transferCount, @fileVersion);
            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            { transferCount := sizeof(INTEGER);   This is the same as before }
            myErr := FSWrite(ourFileRefNum, transferCount, @numCircles);
            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            { transferCount := sizeof(INTEGER);   This is the same as before }
            myErr := FSWrite(ourFileRefNum, transferCount, @activeCircle);
            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            { transferCount := sizeof(INTEGER);   This is the same as before }
            myErr := FSWrite(ourFileRefNum, transferCount, @circleInset);
            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            HLock(Handle(printRecord));
            transferCount := sizeof(TPrint);
            myErr := FSWrite(ourFileRefNum, transferCount, Ptr(printRecord^));
            HUnlock(Handle(printRecord));
            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            transferCount := sizeof(CircleRec);
            FOR counter := 1 TO numCircles DO
                BEGIN
                    myErr := FSWrite(ourFileRefNum, transferCount,
                    @circleArray[counter]);
                    IF myErr <> noErr THEN
                        counter := numCircles;
                END;                             { loop to write circle array }
            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            myPB.ioCompletion := NIL;
            myPB.ioRefNum := ourFileRefNum;
            myPB.ioResult := noErr;
            myErr := PBFlushFile(@myPB, FALSE); { synchronous flush call }

            IF myErr <> noErr THEN
                Exit(PutDocumentToFileGuts);

            SetDocumentDirtyFlag(theDoc, kDocumentClean);

        END; {with theDoc^ do begin }

END; { PutDocumentToFileGuts }

{$S Main}
(******************************************************************************
*
* private: PutDocumentToFile
*
* This routine is a shell function.  It saves the existing file information
* in the document and calls PutDocumentToFileGuts, which returns whenever
* it finds an error.  If it returns with no error, the document was correctly
* written to disk.
*
******************************************************************************)

FUNCTION PutDocumentToFile(theDoc: DocumentPtr): BOOLEAN;

VAR
    oldFileLikeSpec: FileLikeSpec;    { copy of old file information in case
                                      there's an error and we need it back }
    oldFileRefNum: INTEGER;            { copy of old file refNum -- same reason }
    myErr,                            { error for PutDocumentToFileGuts }
    ignore: OSErr;                    { error we ignore when we can't use myErr }

BEGIN
    myErr := noErr;                    { assume nothing goes wrong }
    WITH theDoc^ DO
        BEGIN
            oldFileLikeSpec := ourFile;            { save old file information }
            oldFileRefNum := ourFileRefNum;        { save old reference number }
            PutDocumentToFileGuts(theDoc, myErr);         { write it to disk }
            IF (myErr <> noErr) THEN
                BEGIN
                    ignore := FSClose(ourFileRefNum);
                    ourFileRefNum := oldFileRefNum;
                    ourFile := oldFileLikeSpec;
                    HandleFileError(myErr, ourFile.name);
                END;
        END;

    PutDocumentToFile := (myErr = noErr);
END; { PutDocumentToFile }

{$S Main}
(******************************************************************************
*
* Public: InvalidateCircle
*
* This routine is an accessor function; it invalidates a CircleRec's rectangle
* in the current GrafPort.
*
******************************************************************************)

PROCEDURE InvalidateCircle(theCircle: CircleRecPtr);

BEGIN
    InvalRect(theCircle^.circleRect);
END; { InvalidateCircle }

{$S Main}
(******************************************************************************
*
* private: ChangeActiveCircle
*
* This procedure changes a document's currently active circle to the one
* passed in newActive, invalidating both the old and the new circles if
* the active circle actually changed.
*
******************************************************************************)

PROCEDURE ChangeActiveCircle(newActive: INTEGER; theDoc: DocumentPtr);

BEGIN
    WITH theDoc^ DO
        IF activeCircle <> newActive THEN
            BEGIN
                InvalidateCircle(@circleArray[activeCircle]);
                activeCircle := newActive;
                InvalidateCircle(@circleArray[activeCircle]);
            END; { if }
END; { ChangeActiveCircle }

{$S Main}
(******************************************************************************
*
* private: MakeDefaultCircle
*
* This routine takes a pointer to a circle record and a number saying which
* circle in a document this one is supposed to be.  The routine goes to
* our resource fork and gets the default font, color, size and text for that
* circle number and creates the circle to meet those specifications.
*
*
******************************************************************************)

PROCEDURE MakeDefaultCircle(circleNum: INTEGER; circleRecToFill: CircleRecPtr);

VAR
    colorResHandle: Handle;            { Handle to the resource with our color }

BEGIN
    WITH circleRecToFill^ DO
        BEGIN
            GetIndString(circleFont, rDefaultFonts, circleNum);

            { This Line is semi-tricky.  It says "Get the resource of type
              'DfSz' with ID rDefaultSizes, dereference it once to get a
              pointer, pretend that's a pointer to an INTEGER, and then
              dereference _that_ pointer to get a real INTEGER.  Assign
              that INTEGER to circleTxSize.

              And they say C is hard to understand.  You can obscure any
              language if you try hard enough.  C just makes it easier.  }

            circleTxSize := IntegerPtr(GetResource('DfSz', rDefaultSizes)^)^;
            GetIndString(circleText, rDefaultStrings, circleNum);
            colorResHandle := GetResource('rgb ', rDefaultColorID + circleNum);
            IF colorResHandle = NIL THEN
                colorResHandle := GetResource('rgb ', rDefaultColorID); { this
                one is required }
            BlockMove(colorResHandle^, Ptr(@circleColor), sizeof(RGBColor));
            circleFace := [];        { Empty style; there are no default style
                                      resources }
        END; { WITH circleRecToFill DO BEGIN }
END; { MakeDefaultCircle}

{$S Main}
(******************************************************************************
*
* private: GetCircleRectSize
*
* This routine takes a document and returns the size of a circle's rectangle
* and inset in that document in two var parameters -- rectSize and insetSize.
* If usePrefs is TRUE, the values come from the preferences and theDoc is
* ignored.
*
* This routine assumes that all circles in a document have the same size
* and inset as the first one, which is TRUE for our files.  just noting it.
*
******************************************************************************)

PROCEDURE GetCircleRectSize(theDoc: DocumentPtr; VAR rectSize: INTEGER;
                            VAR insetSize: INTEGER; usePrefs: BOOLEAN);

BEGIN
    IF usePrefs THEN
        BEGIN
            rectSize := gPrefsRecord.circleRectSize;
            insetSize := gPrefsRecord.circleInsetSize;
        END
    ELSE
        BEGIN
            insetSize := theDoc^.circleInset;
            WITH theDoc^.circleArray[1].circleRect DO
                rectSize := (right - left) + (2 * insetSize);
        END;
END; { GetCircleRectSize }

{$S Main}
(******************************************************************************
*
* private: AddCircle
*
* This routine takes a document and a circle, and adds the circle to the
* document.  The circle becomes the last one in the document.  If makeActive
* is TRUE, the new circle is made the active circle.
*
*
******************************************************************************)

PROCEDURE AddCircle(theDoc: DocumentPtr; theCircleToAdd: CircleRecPtr;
                    makeActive: BOOLEAN);

VAR
    nextCircle: INTEGER;            { what circle are we adding? }
    circleTop: INTEGER;                { Y position of the new circle's top }
    rectSize: INTEGER;                { size of the circle's rectangle }
    insetSize: INTEGER;                { the circle's inset value }

BEGIN

    nextCircle := theDoc^.numCircles + 1;    { Circle to add }
    IF nextCircle <= gPrefsRecord.maxNumCircles THEN
        BEGIN
            theDoc^.numCircles := nextCircle;
            theDoc^.circleArray[nextCircle] := theCircleToAdd^;

            { Now that we've copied the circle, adjust the rectangle
              to the right size }

            GetCircleRectSize(theDoc, rectSize, insetSize,
                              (nextCircle = 1));

            { The top of the next circle is the the height of all the other
              rectangles (squares) times the number of existing circles }

            circleTop := (nextCircle - 1) * rectSize; { do this calculation only
                                                        once }
            SetDocumentDirtyFlag(theDoc, kDocumentDirty);

            WITH theDoc^.circleArray[nextCircle] DO
                BEGIN
                    SetRect(circleRect, 0, circleTop, rectSize, circleTop +
                            rectSize);
                    InsetRect(circleRect, insetSize, insetSize);
                END; { WITH theDoc^.circleArray[nextCircle] DO BEGIN }

            IF makeActive THEN
                ChangeActiveCircle(nextCircle, theDoc);

        END; {if nextCircle <= gPrefsRecord.maxNumCircles }
END; { AddCircle }

{$S Main}
(******************************************************************************
*
* Public: GetDocumentDrawingSize
*
* This routine returns the size of a document, in pixels (as a Point
* structure).  Like GetCircleRectSize, it requires changing if all circles
* in a document aren't the same size as the first one.
*
******************************************************************************)

PROCEDURE GetDocumentDrawingSize(theDoc: DocumentPtr; VAR theSize: Point);

VAR
    rectSize,                    { size of each circle's rectangle }
    insetSize: INTEGER;            { inset for each circle from its Rect }

BEGIN

    GetCircleRectSize(theDoc, rectSize, insetSize,
                      (theDoc^.numCircles < 1));    { use prefs if no circles
                                                          in document }
    theSize.v := theDoc^.numCircles * rectSize;
    theSize.h := rectSize;
END; { GetDocumentDrawingSize }

{$S Main}
(******************************************************************************
*
* private: AdjustWindowSize
*
* AdjustWindowSize takes a window and a DocumentPtr and makes the window
* just the right size to draw the document in.
*
*
******************************************************************************)

PROCEDURE AdjustWindowSize(window: WindowPtr; theDoc: DocumentPtr);

VAR
    theSize: Point;                { size of doc as returned by our routine
                                  GetDocumentDrawingSize }

BEGIN
    GetDocumentDrawingSize(theDoc, theSize);
    SizeWindow(window, theSize.h, theSize.v, TRUE);
END; { AdjustWindowSize }

{$S Main}
(******************************************************************************
*
* Public: AddDefaultCircle
*
* This routine adds the "next" circle as the default circle to a document
* and, optionally, its window.  If there's a window pointer, that window
* is resized to fit the new document.
*
******************************************************************************)

PROCEDURE AddDefaultCircle(theDoc: DocumentPtr; theWindow: WindowPtr);

VAR
    ourCircle: CircleRec;            { the circle we add }

BEGIN
    MakeDefaultCircle(theDoc^.numCircles + 1, @ourCircle);
    AddCircle(theDoc, @ourCircle, FALSE);
    IF theWindow <> NIL THEN
        AdjustWindowSize(theWindow, theDoc);
    SetDocumentDirtyFlag(theDoc, kDocumentDirty);
END; { AddDefaultCircle }

{$S Main}
(******************************************************************************
*
* Public: DeleteActiveCircle
*
* This routine deletes the active circle from a window's document.  You should
* not call this if there's only one circle in the document, but it does
* watch for that to avoid problems elsewhere.  The document is marked dirty.
*
* If the circle is not the last one, all the circles below it are upshifted
* so there are no gaps, and the window is resized and completely redrawn.
*
******************************************************************************)

PROCEDURE DeleteActiveCircle(theWindow: WindowPtr);

VAR
    oldActive,                    { the active circle before we delete }
    oldNumber,                     { the number of circles before we delete }
    counter,                    { loop counter variable }
    rectSize,                     { size of each circle's rectangle }
    insetSize: INTEGER;            { inset value for each circle, ignored }
    theDoc: DocumentPtr;        { the window's associated document }

BEGIN
    theDoc := DocumentPtr(GetWRefCon(theWindow));
    WITH theDoc^ DO
        BEGIN
            oldActive := activeCircle;
            oldNumber := numCircles;
            numCircles := numCircles - 1;
            GetCircleRectSize(theDoc, rectSize, insetSize, FALSE);
            FOR counter := oldActive + 1 TO oldNumber DO
                BEGIN
                    circleArray[counter - 1] := circleArray[counter];
                    OffsetRect(circleArray[counter - 1].circleRect, 0,
                               -rectSize);
                END;
            activeCircle := activeCircle - 1;
            IF activeCircle < 1 THEN
                activeCircle := 1;
            SetDocumentDirtyFlag(theDoc, kDocumentDirty);
            AdjustWindowSize(theWindow, theDoc);
            InvalRect(theWindow^.portRect);
        END; { with }
END; { DeleteActiveCircle }

{$S Main}
(******************************************************************************
*
* private: FindWindowByFileSpec
*
* This would be in SampleUtilities if it didn't have specific knowledge of our
* document structure, because it's kind of handy.
*
* FindWindowByFileSpec takes a FileLikeSpec and calls PBGetCatInfo on it,
* synchronously, to find the file's reference number.  It then walks through
* all windows, looking in each application window's associated document
* structure for a document sharing the same file number.  If it finds one,
* it returns that window's pointer.
*
* This is used by our "open" routine so that if you open a file that's
* already open, the window is selected and brought to the front instead of
* generating a "That file is already open" error.
*
******************************************************************************)

FUNCTION FindWindowByFileSpec(theFile: FileLikeSpecPtr): WindowPtr;

VAR
    ourPB: CInfoPBRec;                { parameter block for PBGetCatInfo }
    myErr: OSErr;                    { error code from PBGetCatInfo }
    aWindow: WindowPtr;                { the window we're examining }
    theRefNum: INTEGER;                { the passed file's reference number }
    foundIt: BOOLEAN;                { did we find the window? }

BEGIN
    foundIt := FALSE;                    { assume no window matches }
    WITH ourPB DO
        BEGIN
            ioNamePtr := @theFile^.name;        { set up our PB: file name }
            ioVRefNum := theFile^.vRefNum;        { copy the vRefNum }
            ioFDirIndex := 0;                    { this should be zero }
            ioDirID := theFile^.parID            { the directory ID }
        END;
    myErr := PBGetCatInfo(@ourPB, FALSE);

    IF myErr = noErr THEN
        BEGIN
            theRefNum := ourPB.ioFRefNum;        { copy the refNum }
            aWindow := FrontWindow;                { start with the front window }

            WHILE (aWindow <> NIL) AND NOT foundIt DO
                BEGIN
                    IF IsAppWindow(aWindow) THEN
                        IF DocumentPtr(GetWRefCon(aWindow))^.ourFileRefNum =
                               theRefNum THEN
                                foundIt := TRUE;
                    IF NOT foundIt THEN
                        aWindow := GetNextWindow(aWindow);
                END; { WHILE }
        END; { IF myErr = noErr }

    IF foundIt THEN
        FindWindowByFileSpec := aWindow
    ELSE
        FindWindowByFileSpec := NIL;

END; { FindWindowByFileSpec }

{$S Main}
(******************************************************************************
*
* private: GetDocumentFromFileGuts
*
* This routine fills in a document pointed to by theDoc and fills it in with
* the contents of the file referenced.  If theFile is NIL, we call the
* Standard file Package to get a file to open.  Like PutDocumentToFile,
* the first thing we do is turn the working directory information in the
* SFReply record into a real vRefNum and dirID, and fill in a new FileLikeSpec
* with the information.
*
* Then, we try to open the file, assuming no errors and no user cancellations.
* If HOpen says the disk is write-protected, or the file is locked, or the
* volume is locked, or there is no write permission, or maybe just an
* AppleShare-type access privileges error, then we try to open the file
* read-only.  If that works, either the file is already open by us or
* we just can't open it with write permission.  If it's the former, we just
* select the window.  If it's the latter, we open it read-only and Alert
* the user that he can't save changes to this file.  (If he tries, he'll
* get an error.  There's no place in the document structure to say this is
* a read-only document, though that might be a nice thing to do.)
*
* At that Point, we have a good file specification or the user canceled,
* in which case we set myErr to userCanceledErr to indicate something
* went wrong.
*
* The second half of the routine reads the document from disk, one piece
* at a time.  If there's no error from the early part, we set the file
* position to zero in preparation for reading (redundant if it's a new
* file, not redundant if it's not).  Checking for errors after each step,
* we then read the internal file version, the number of circles, the
* active circle number and the circle inset.  Then follows the print
* record, which is validated to make sure it's still good for the current
* printer driver.  Then comes the array of circles.  After that, if it all
* worked, we set our "success" flag to indicate such.
*
* Note that if the file format changes, you have to change this routine,
* GetDocumentDiskSize and PutDocumentToFileGuts.
*
* when we back out of all the error checking, we look to see if the file
* is a stationery file.  If it is, we close the file, change the window
* title and file name to the next "untitled" String, mark the document
* as dirty and as unsaved by zeroing the file reference number.
*
* The whole routine returns noErr in the VAR myError if everything was
* fine.
*
* This routine is a guts routine -- it's called from GetDocumentFromFile
* (below).  This routine returns any time it encounters an error, after
* appropriate clean-up.  Not to do it this way requires so many levels
* of "IF myErr = noErr THEN" that it becomes almost unreadable.
*
******************************************************************************)

PROCEDURE GetDocumentFromFileGuts(theFile: FileLikeSpecPtr; theDoc: DocumentPtr;
                                    VAR myErr : OSErr);

VAR
    where: Point;                    { location for SFGetFile dialog }
    procID: LONGINT;                { unused, required by GetWDInfo }
    theVRefNum: INTEGER;            { real vRefNum for SFGetFile result }
    theDirID: LONGINT;                { real dirID for SFGetFile result }
    myTypeList: SFTypeList;            { the typeList for SFGetFile filtering }
    transferCount: LONGINT;            { count of bytes read from disk }
    fileVersion: INTEGER;            { variable to hold our file version constant }
    ignore,                            { throw-away result of PrValidate }
    isStationeryDoc: BOOLEAN;        { is this file stationery? }
    counter: INTEGER;                { loop variable counter }
    theRefNum: INTEGER;                { reference number of the file we open }
    ourFInfo: FInfo;                { for checking the isStationery bit }
    newFileSpec: FileLikeSpec;        { holder for the file we're opening's specs }
    myReply: SFReply;                { the user's SFGetFile choice }
    theWindow: WindowPtr;            { for the already-open window, if there is one }

BEGIN

    IF theFile = NIL THEN
        BEGIN
            where.h := 50;
            where.v := 50;
            myTypeList[0] := kOurDocumentType;
            SFGetFile(where, '', NIL, 1, myTypeList, NIL, myReply);
            IF NOT myReply.good THEN BEGIN
                myErr := userCanceledErr;
                Exit(GetDocumentFromFileGuts);
            END;

            procID := 0;
            myErr := GetWDInfo(myReply.vRefNum, theVRefNum, theDirID, procID);

            { If they passed NIL for theFile, we can't fill in a NIL pointer
              with a new FileLikeSpec, so we use a local variable for the rest
              of the routine, just in case }

            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            newFileSpec.vRefNum := theVRefNum;
            newFileSpec.parID := theDirID;
            newFileSpec.name := myReply.fName;
        END
    ELSE
        newFileSpec := theFile^;        { copy the passed spec into our variable }

    WITH newFileSpec DO
        BEGIN

            { Is this a stationery file?  If so, we'll eventually close
              the file on disk and treat it as an "untitled" document
              with initial content that's dirty.  We want to know now,
              though, so we can avoid warning users that stationery is
              locked (like they care). }

            myErr := HGetFInfo(vRefNum, parID, name, ourFInfo);
            isStationeryDoc := FALSE;
            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            isStationeryDoc := (BAND(ourFInfo.fdFlags, kIsStationary) <> 0);
                                            { yes, _I_ know it's misspelled... }

            myErr := HOpen(vRefNum, parID, name, fsRdWrPerm, theRefNum);

            IF myErr <> noErr THEN
                BEGIN

                    { Try to open read-only, and if we can, see if we already
                      have the file open. }

                    myErr := HOpen(vRefNum, parID, name, fsRdPerm, theRefNum);

                    { If we can't open it read-only, either, we're sunk. }

                    IF myErr <> noErr THEN
                        Exit(GetDocumentFromFileGuts);

                    theWindow := FindWindowByFileSpec(@newFileSpec);
                    IF ((theWindow = NIL) AND (NOT isStationeryDoc)) THEN
                        BEGIN
                            ParamText('', name, '', '');
                            AlertUser(rFileDiskLocked);
                        END
                    ELSE IF (NOT isStationeryDoc) THEN
                        BEGIN
                            myErr := FSClose(theRefNum);
                            SelectWindow(theWindow);
                            myErr := userCanceledErr;
                            Exit(GetDocumentFromFileGuts);
                        END;
                END;                { IF myErr <> noErr }
        END;                         { WITH }

    WITH theDoc^ DO
        BEGIN         { here's where we use the reference number and do our thing }
            myErr := SetFPos(theRefNum, fsFromStart, 0); { Move to start of file }
            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            transferCount := sizeof(INTEGER);
            myErr := FSRead(theRefNum, transferCount, @fileVersion);
            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            IF fileVersion <> kFileInternalVersion THEN
                BEGIN
                    AlertUser(rFileVersionInconsistent);
                    myErr := noErr;
                    Exit(GetDocumentFromFileGuts);
                END;

            { transferCount := sizeof(INTEGER);   This is the same as before }
            myErr := FSRead(theRefNum, transferCount, @numCircles);
            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            { transferCount := sizeof(INTEGER);   This is the same as before }
            myErr := FSRead(theRefNum, transferCount, @activeCircle);
            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            { transferCount := sizeof(INTEGER);   This is the same as before }
            myErr := FSRead(theRefNum, transferCount, @circleInset);
            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            { Lock the print record Handle before reading into it, and call
              PrValidate on it when we have it. }

            HLock(Handle(printRecord));
            transferCount := sizeof(TPrint);
            myErr := FSRead(theRefNum, transferCount, Ptr(printRecord^));
            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            HUnlock(Handle(printRecord));
            PrOpen;
            ignore := PrValidate(printRecord);
            PrClose;

            transferCount := sizeof(CircleRec);
            FOR counter := 1 TO numCircles DO
                BEGIN
                    myErr := FSRead(theRefNum, transferCount, @circleArray[counter]);
                    IF myErr <> noErr THEN
                        counter := numCircles;
                END; { loop to read circle array }

            IF myErr <> noErr THEN
                Exit(GetDocumentFromFileGuts);

            ourFile := newFileSpec;                    { fill in our FileLikeSpec }

            { Now, if it's stationery, close the old file and pretend like it's
              a "new" document but with some initial content }

            IF isStationeryDoc THEN
                BEGIN
                    ourFile.vRefNum := 0;
                    ourFile.parID := 0;
                    myErr := FSClose(theRefNum);
                    ourFileRefNum := 0;
                    CreateWindowTitle(ourFile.name);
                    SetDocumentDirtyFlag(theDoc, kDocumentNew);
                                            { pretend this is a new document! }
                END
            ELSE
                BEGIN
                    ourFileRefNum := theRefNum;
                    SetDocumentDirtyFlag(theDoc, kDocumentClean);
                END;

        END;

END; { GetDocumentFromFileGuts }

{$S Main}
(******************************************************************************
*
* Public: GetDocumentFromFile
*
* This is a shell routine; it calls GetDocumentFromFileGuts, which returns
* if it encounters any errors.  This routine returns TRUE to the caller
* if the document was put to file without errors.  The description of all
* the mechanics is above in GetDocumentFromFileGuts.
*
******************************************************************************)

FUNCTION GetDocumentFromFile(theFile: FileLikeSpecPtr; theDoc: DocumentPtr):
                            BOOLEAN;

VAR
    myErr: OSErr;                        { for GetDocumentFromFileGuts }

BEGIN
    myErr := noErr;                        { assume no problems }
    GetDocumentFromFileGuts(theFile, theDoc, myErr);
    GetDocumentFromFile := (myErr = noErr);    { return TRUE if no problems }
END; { GetDocumentFromFile }

{$S Main}
(******************************************************************************
*
* private: InitializeDefaultDoc
*
* This routine takes a document structure and makes it equal to the "default"
* document you get when you pick "New" from the file menu.  It returns
* FALSE if it can't initialize the document, though it always can right now.
*
******************************************************************************)

FUNCTION InitializeDefaultDoc(theDoc: DocumentPtr): BOOLEAN;

VAR
    counter: INTEGER;                { loop variable counter }

BEGIN
    theDoc^.activeCircle := 1;        { Default active circle }
    theDoc^.numCircles := 0;        { start with none in document }
    theDoc^.ourFileRefNum := 0;     { to indicate never saved to disk }
    theDoc^.ourFile.vRefNum := 0;
    theDoc^.ourFile.parID := 0;
    theDoc^.circleInset := gPrefsRecord.circleInsetSize;

    FOR counter := 1 TO kDefaultNum DO
        AddDefaultCircle(theDoc, NIL);

    CreateWindowTitle(theDoc^.ourFile.name);

    PrOpen;
    PrintDefault(theDoc^.printRecord);
    PrClose;

    SetDocumentDirtyFlag(theDoc, kDocumentNew); { even though
                                                  AddDefaultCircle dirties
                                                  this, we're clean }

    InitializeDefaultDoc := TRUE; { no way for this to fail presently }

END; { InitializeDefaultDoc }

{$S Main}
(******************************************************************************
*
* Public: MakeEmptyDoc
*
* This routine allocates all the memory for a new document, allocating the
* space for the document and for other associated structures like the
* print record.  If at least kMemoryCushionSize bytes aren't available,
* we refuse to Create a document, alerting the user that there's a problem.
* The caller could just as easily Alert the user, but it's more convenient
* for us to do it here.
*
******************************************************************************)

FUNCTION MakeEmptyDoc: DocumentPtr;

VAR
    theDoc: DocumentPtr;            { the pointer we Allocate with NewPtr }
    tempHandle: Handle;                { Handle to check the memory cushion }

BEGIN
    theDoc := NIL;
    tempHandle := NewHandle(kMemoryCushionSize);
    IF tempHandle <> NIL THEN
        BEGIN
            DisposeHandle(tempHandle);

            { NewPtrClear pre-zeroes the Handle, so we don't have to worry
              about it being filled with garbage.  The system does it faster
              than we can. }

            theDoc := DocumentPtr(NewPtrClear(sizeof(document)));

            IF theDoc <> NIL THEN
                theDoc^.printRecord := THPrint(NewHandle(sizeof(TPrint)));

        END;

    { We use the short-circuit OR ("|") here so that we don't dereference
      theDoc if it's NIL.  For more information on short-circuit booleans,
      see the description of ClassifyKey in its implementation in the
      SampleUtilities unit. }

    IF ((theDoc = NIL) | (theDoc^.printRecord = NIL)) THEN
        AlertUser(rNoMemForWindow);

    MakeEmptyDoc := theDoc;

END; { MakeEmptyDoc }

{$S Main}
(******************************************************************************
*
* Public: MakeWindowFromDoc
*
* This routine creates a new window and associates it with the document
* passed to it by storing the document pointer in the window's refCon
* field.  The window is created invisibly (as specified by our 'WIND'
* resource) so we don't redraw as we resize and change titles.
* We Create a color window if we have color QuickDraw, and a regular
* window if we don't.  The window's title is set to the document's
* file name, and it's resized and shown.  We return the window pointer,
* including returning NIL if we couldn't Allocate memory for it (but
* we also Alert the user about this).
*
* We use NewPtr and Allocate our own window record storage instead of letting
* the system do it.  This lets us Handle our own memory management better
* We try pretty hard not to leave handles locked for very long, and not
* to Allocate new unrelocatable blocks if other things are locked.  This
* does a fairly good job of keeping our heap organized.
*
* This is a simple strategy, but this is a simple application.
*
******************************************************************************)

FUNCTION MakeWindowFromDoc(theDoc: DocumentPtr): WindowPtr;

VAR
    window: WindowPtr;                { the window we're creating }

BEGIN

    window := WindowPtr(NewPtr(sizeof(WindowRecord)));
    IF window = NIL THEN
        AlertUser(rNoMemForWindow)

    ELSE
        BEGIN
            IF gHasColorQD THEN
                window := GetNewCWindow(rWindow, Ptr(window), WindowPtr( - 1))
            ELSE
                window := GetNewWindow(rWindow, Ptr(window), WindowPtr( - 1));

            SetPort(window);
            SetWRefCon(window, LONGINT(theDoc));

            SetWTitle(window, theDoc^.ourFile.name);
            AdjustWindowSize(window, theDoc);
            ShowWindow(window);
        END;

    MakeWindowFromDoc := window;

END; { MakeWindowFromDoc }

{$S Main}
(******************************************************************************
*
* Public: DoNew
*
* DoNew is called by Sample.p every time the user picks the "New" command
* from the "file" menu, or when we receive an 'oapp' event.  It creates a
* default, untitled document window and returns the pointer to it, or
* NIL if this failed.
*
******************************************************************************)

FUNCTION DoNew: WindowPtr;

VAR
    aDocument: DocumentPtr;            { the document we Create }
    ignore: BOOLEAN;                { ignored function result }

BEGIN
    aDocument := MakeEmptyDoc;
    IF aDocument <> NIL THEN        { if the document was created }
        BEGIN                        { initialize it and make a window }
            ignore := InitializeDefaultDoc(aDocument);
            DoNew := MakeWindowFromDoc(aDocument);
        END
    ELSE
        DoNew := NIL;
END; { DoNew }

{$S Main}
(******************************************************************************
*
* Public: DoOpenDocument
*
* This routine takes a pointer to a FileLikeSpec for a document on disk and
* returns a pointer to a new window containing that document.  It calls
* GetDocumentFromFile to fill in an empty document that it creates.  That
* routine calls Standard file if the FileLikeSpecPtr is NIL, asking the
* user to pick a file.  If we can't get a document from disk, the new document
* structure is disposed.
*
* This routine works nicely to return windows whether or not the user
* needs to open them or not.
*
******************************************************************************)

FUNCTION DoOpenDocument(theFileSpec: FileLikeSpecPtr): WindowPtr;

VAR
    theDocument: DocumentPtr;            { the document we Create }
    success: BOOLEAN;                    { did DoOpenDocument succeed? }

BEGIN
    theDocument := MakeEmptyDoc;
    success := GetDocumentFromFile(theFileSpec, theDocument);
    IF success THEN
        DoOpenDocument := MakeWindowFromDoc(theDocument)
    ELSE
        BEGIN
            DoOpenDocument := NIL;
            success := DisposeDocument(theDocument); { ignore the result }
        END;
END; { DoOpenDocument }

{$S Main}
(******************************************************************************
*
* Public: DoSave
*
* DoSave takes a window pointer and writes the window's document to a disk
* file, returning TRUE if all went well.  The window's title is also changed
* to reflect the name of the document on disk, which results in no visible
* change if it was saved with the same file name.
*
******************************************************************************)

FUNCTION DoSave(theWindow: WindowPtr): BOOLEAN;

VAR
    theDoc: DocumentPtr;
    returnValue: BOOLEAN;

BEGIN
    theDoc := DocumentPtr(GetWRefCon(theWindow));
    returnValue := PutDocumentToFile(theDoc);
    IF returnValue THEN
        SetWTitle(theWindow, theDoc^.ourFile.name);
    DoSave := returnValue;
END; { DoSave }

{$S Main}
(******************************************************************************
*
* Public: DoSaveAs
*
* DoSaveAs is largely like DoSave, except it needs to _always_ prompt the
* user for a new file in which to store the document.  To do this, it
* doesn't close the existing file until the new one is saved, so it can
* still cancel if there was an error.
*
* The routine returns TRUE if the document was succesfully saved in a new
* place.
*
******************************************************************************)

FUNCTION DoSaveAs(theWindow: WindowPtr): BOOLEAN;

VAR
    theDoc: DocumentPtr;                    { this window's document structure }
    myErr: OSErr;                            { error from file Manager calls }
    returnValue: BOOLEAN;                    { return from PutDocumentToFile }
    oldRefNum: INTEGER;                        { current refNum, for storage }
    oldFileLikeSpec: FileLikeSpec;            { current FileLikeSpec, for storage }

BEGIN
    theDoc := DocumentPtr(GetWRefCon(theWindow));
    oldRefNum := theDoc^.ourFileRefNum;
    oldFileLikeSpec := theDoc^.ourFile;

    returnValue := PutDocumentToFile(theDoc);
    IF returnValue THEN
        BEGIN
            SetWTitle(theWindow, theDoc^.ourFile.name);
            IF oldRefNum <> 0 THEN
                BEGIN
                    myErr := FSClose(oldRefNum);
                    IF myErr <> noErr THEN
                        HandleFileError(myErr, oldFileLikeSpec.name);
                END;
        END
    ELSE
        BEGIN
            theDoc^.ourFileRefNum := oldRefNum;
            theDoc^.ourFile := oldFileLikeSpec;
        END;

    DoSaveAs := returnValue;
END; { DoSaveAs }

{$S Main}
(******************************************************************************
*
* Public: CloseAppWindow
*
* CloseAppWindow is a "shell" function, called by Sample.p every time it
* wants to close a window that belongs to the application.  (Sample.p already
* knows how to close desk accessory windows under System 6, for example.)
*
* If the document is dirty, and if we can interact with the user, we ask
* the user if changes should be saved.  If they say "Save," we call DoSave
* to save the file, returning TRUE if this completes without error.
* If they say "Don't Save", we close the window, dispose of the window record
* and return TRUE.  If they cancel, or if there's an error in saving, we return
* FALSE to tell the caller "Hey, this window didn't get closed."
*
* "action" is a constant, either kClosing or kQuitting, so we can tell the
* user what's going on in the prompt.
*
******************************************************************************)

FUNCTION CloseAppWindow(theWindow: WindowPtr; action: INTEGER): BOOLEAN;

VAR
    theDoc: DocumentPtr;            { this window's document structure }
    result: INTEGER;                { result of asking the user to save }

BEGIN
    theDoc := DocumentPtr(GetWRefCon(theWindow));

    CloseAppWindow := FALSE;         { assume we're not going to close }
    result := kDontSave;             { assume we're going to close without
                                      saving }

    IF (GetDocumentDirtyFlag(theDoc) = kDocumentDirty) THEN
        BEGIN
            result := DoPromptSave(theDoc^.ourFile.name, action);
            IF result = kSave THEN
                IF NOT DoSave(theWindow) THEN
                    result := kCancel; { if saving got an error, cancel the
                                         close operation }
        END;

    IF result <> kCancel THEN
        BEGIN
            CloseWindow(theWindow);

            { We dispose of the window record's memory here because
              we allocated it, not the window Manager. }

            DisposePtr(Ptr(theWindow));
            CloseAppWindow := DisposeDocument(theDoc);
        END;
END; { CloseAppWindow }

{$S Main}
(******************************************************************************
*
* private: OpenPrefsFile
*
* This routine finds our preferences file on the boot volume and opens it,
* returning the refNum of the resource file.  If one isn't found, it creates it.
*
* The preferences file is supposed to be in the "Preferences" folder as
* defined by FindFolder, and I would have sworn I once read a Technical Note
* saying to Create and use such a folder under System 6 as well.  However,
* I can find no record of such a note, and the FindFolder glue for System 6
* maps the kPreferencesFolderType to the system folder, giving strong argument
* that preferences files should be loose in the system folder under System 6.
* so that's what we do.
*
* THINK Pascal doesn't support the glue for FindFolder, meaning we can't
* call it unless the trap is implemented.  MPW Pascal 3.0 and later do support
* the glue.  so, we only call FindFolder if the trap is implemented
* (gHasFindFolder = TRUE) or if we're not using THINK Pascal.  Otherwise,
* we use SysEnvirons and GetWDInfo to get the vRefNum and dirID of the
* system folder.
*
* Once we have the folder, we try to open the file.  If it's not found,
* we attempt to Create it and set the creator and file type appropriately.
* Then we try again to open it, returning -1 if we can't make a preferences
* file available.
*
******************************************************************************)

FUNCTION OpenPrefsFile: INTEGER;

VAR
    myErr: OSErr;                        { error from system calls }
    foundVRefNum,                        { vRefNum for system folder }
    prefsRefNum: INTEGER;                { refNum for our preferences file }
    foundDirID,                            { dirID of the system folder }
    ignoreThis: LONGINT;                { unused procID for GetWDInfo }
    prefsFileName: Str255;                { name for our preferences file }
    prefsFileNameHandle: StringHandle;    { file name Handle returned by GetString }
    ourFInfo: FInfo;                    { for setting our file and creator type }
    ThinkPascal: BOOLEAN;                { TRUE if this is THINK Pascal }
    mySysEnvRec: SysEnvRec;                { for SysEnvirons call if no FindFolder }

BEGIN
    prefsRefNum := - 1;                 { couldn't open the file }
    prefsFileNameHandle := GetString(rPrefsFileName);
    BlockMove(Ptr(prefsFileNameHandle^), @prefsFileName,
              length(prefsFileNameHandle^^) + 1);
                                          { make static copy of file name }
    ReleaseResource(Handle(prefsFileNameHandle)); { free up the String's space }

    {$IFC UNDEFINED Think_Pascal}
    ThinkPascal := FALSE;
    {$ELSEC}
    ThinkPascal := TRUE;
    {$ENDC}

    { THINK Pascal requires the FindFolder trap, so don't use it if we can't }

    IF gHasFindFolder OR (NOT ThinkPascal) THEN
        myErr := FindFolder(kOnSystemDisk, kPreferencesFolderType,
                            kCreateFolder, foundVRefNum, foundDirID)
    ELSE
        BEGIN

            { No FindFolder, so get the system folder info from SysEnvirons }

            myErr := SysEnvirons(curSysEnvVers, mySysEnvRec);
            IF myErr = noErr THEN
                myErr := GetWDInfo(mySysEnvRec.sysVRefNum, foundVRefNum,
                                   foundDirID, ignoreThis);
        END;

    IF myErr = noErr THEN
        BEGIN
            prefsRefNum := HOpenResFile(foundVRefNum, foundDirID, prefsFileName,
                                        fsRdWrPerm);
            IF ((prefsRefNum = - 1) AND (ResError = fnfErr)) THEN
                BEGIN

                    { Create the missing prefs file if possible, and set the
                      file and creator types correctly }

                    HCreateResFile(foundVRefNum, foundDirID, prefsFileName);
                    myErr := ResError;
                    myErr := HGetFInfo(foundVRefNum, foundDirID, prefsFileName,
                                       ourFInfo);
                    ourFInfo.fdType := kSamplePrefsType;
                    ourFInfo.fdCreator := kOurCreatorType;
                    myErr := HSetFInfo(foundVRefNum, foundDirID, prefsFileName,
                                       ourFInfo);
                    prefsRefNum := HOpenResFile(foundVRefNum, foundDirID,
                                                prefsFileName, fsCurPerm);
                END;
            OpenPrefsFile := prefsRefNum;
        END;                             { if HOpenResFile didn't work }
END; { OpenPrefsFile }

{$S Main}
(******************************************************************************
*
* Public: PutPrefsToFile
*
* This routine writes a preferences record as a resource of type
* kSamplePrefsRsrc and ID rSamplePrefsID to the resource file referenced
* by theRefNum.  The resource format is the same as the record format.
* If the reference number is anything but -1, it's the refNum of an open
* resource file to write to.  If it's -1, we call OpenPrefsFile to open
* a preferences file.
*
******************************************************************************)

PROCEDURE PutPrefsToFile(thePrefs: preferences; theRefNum: INTEGER);

VAR
    newRefNum,                            { refNum for new file if needed }
    oldResFile: INTEGER;                { current resource file on entry }
    ourPrefsHandle: Handle;                { Handle to the prefs record }
    testPrefsHandle: Handle;            { Handle to test if there's already
                                          a prefs resource in the file }

BEGIN
    oldResFile := CurResFile;            { save the original resource file }

    IF theRefNum = -1 THEN                { did we reference a real file? }
        newRefNum := OpenPrefsFile        { No, so go open one for us }
    ELSE
        newRefNum := theRefNum;            { yes, so use it }

    UseResFile(newRefNum);                { switch to our resource file }
    ourPrefsHandle := NewHandle(sizeof(preferences));
                                        { make a Handle for the prefs }
    BlockMove(@thePrefs, ourPrefsHandle^, sizeof(preferences));

    { test to see if there's already a preferences resource.  If there is,
      remove it so we can add this one. }

    testPrefsHandle := Get1Resource(kSamplePrefsRsrc, rSamplePrefsID);
    IF testPrefsHandle <> NIL THEN
        BEGIN
            RmveResource(testPrefsHandle);
            DisposeHandle(testPrefsHandle);
        END;
    AddResource(ourPrefsHandle, kSamplePrefsRsrc, rSamplePrefsID, '');
    IF theRefNum = -1 THEN                { if we opened the file ... }
        CloseResFile(newRefNum);        { ...close it when done }
    UseResFile(oldResFile);                { restore the old resource file }

END; { PutPrefsToFile }

{$S Main}
(******************************************************************************
*
* private: GetPrefsFromFile
*
* This routine fills in a preferences record with the contents of the
* prefs resource in our prefs file.  If there is no existing preferences
* file, we fill in the record with hard-coded default values.
*
* If there was a preferences file, and if we created default preferences,
* we write them to the file.
*
******************************************************************************)

PROCEDURE GetPrefsFromFile(VAR thePrefs: preferences);

VAR
    prefsRefNum: INTEGER;            { refNum of the preferences files }
    doDefaultPrefs: BOOLEAN;        { TRUE if we use the default prefs }
    prefsHandle: Handle;            { Handle containing a preferences record }

BEGIN
    doDefaultPrefs := FALSE;        { assume no defaults }
    prefsRefNum := OpenPrefsFile;    { open the preferences file }
    IF prefsRefNum = -1 THEN        { Was there one to open? }
        doDefaultPrefs := TRUE        { if not, return defaults }
    ELSE
        BEGIN                        { there was, so get the resource }
            prefsHandle := GetResource(kSamplePrefsRsrc, rSamplePrefsID);
            IF GetHandleSize(prefsHandle) <> sizeof(preferences) THEN
                doDefaultPrefs := TRUE
            ELSE
                BlockMove(prefsHandle^, @thePrefs, sizeof(preferences));
        END;

    IF doDefaultPrefs THEN
        BEGIN
            WITH gPrefsRecord DO
                BEGIN
                    circleRectSize := 100;
                    circleInsetSize := 5;
                    maxNumCircles := 6;
                END;
        END;

    IF (prefsRefNum <> -1) AND doDefaultPrefs THEN
        BEGIN
            PutPrefsToFile(gPrefsRecord, prefsRefNum);
            IF NOT doDefaultPrefs THEN
                CloseResFile(prefsRefNum);
        END;

END; { GetPrefsFromFile }

{$S Main}
(******************************************************************************
*
* Public: InstallAppAEHandlers
*
* This shell function is called by Sample.p after it installs its Apple
* Event handlers.  We'd install any application-specific event handlers here,
* but we don't have any so it's an empty procedure.
*
******************************************************************************)

PROCEDURE InstallAppAEHandlers;

BEGIN
END; { InstallAppAEHandlers }

{$S Main}
(******************************************************************************
*
* Public: InitializeApplication
*
* This routine is called by Sample.p after it's initialized all the
* stuff not specific to this unit.  Here's where we read the preferences,
* initialize our window counts and take care of startup tasks.
*
* If there's no Apple Event Manager, we need to call the Segment Loader
* to read old-style AppFiles records and open any windows they specify.
* If CountAppFiles returns zero, we open a new untitled window.  Unlike the
* Apple Event 'pdoc' spec, in the old world we open windows for documents
* before we print them, and we return FALSE from this routine so that
* we don't proceed with normal application work.  This makes us quit after
* printing files from GetAppFiles, which is what we're supposed to do.
*
* The routine returns FALSE if we couldn't initialize something.  Sample.p
* will quit if this routine returns FALSE.
*
******************************************************************************)

FUNCTION InitializeApplication: BOOLEAN;

VAR
    window: WindowPtr;                    { window for files we open }
    fileAction: INTEGER;                { what to do with each file }
    fileCount: INTEGER;                    { how many AppFiles are there? }
    count: INTEGER;                        { loop variable counter }
    myAppFile: AppFile;                    { record for GetAppFiles }
    myFileSpec: FileLikeSpec;            { container to specify a file to open }
    ourVRefNum: INTEGER;                { vRefNum for file to open }
    ourDirID: LONGINT;                    { dirID for file to open }
    myErr: OSErr;                        { error from system calls }
    procID: LONGINT;                    { ignored procID for GetWDInfo }
    ignore: BOOLEAN;                    { ignored result from DoPrint }

BEGIN
    GetPrefsFromFile(gPrefsRecord);
    gUntitledWindowCount := 0;
    InitializeApplication := TRUE;

    { Make a new untitled window only if we can't get an 'odoc' event, or if
      there are no files on disk to open or print }

    IF NOT gHasAppleEvents THEN
        BEGIN
            CountAppFiles(fileAction, fileCount);
            IF fileCount > 0 THEN
                FOR count := 1 TO fileCount DO
                    BEGIN
                        GetAppFiles(count, myAppFile);
                        procID := 0;
                        myErr := GetWDInfo(myAppFile.vRefNum, ourVRefNum,
                                           ourDirID, procID);
                        IF (myErr = noErr) AND (myAppFile.fType =
                           kOurDocumentType) THEN
                            BEGIN
                                myFileSpec.vRefNum := ourVRefNum;
                                myFileSpec.parID := ourDirID;
                                myFileSpec.name := myAppFile.fName;
                                window := DoOpenDocument(@myFileSpec);
                                IF fileAction = appPrint THEN
                                    BEGIN
                                        InitializeApplication := FALSE;
                                        ignore := DoPrint(window);
                                    END;     { IF fileAction = appPrint }
                            END;            { IF this is out file to open }
                    END                        { FOR count := 1 to fileCount DO }
            ELSE
                window := DoNew;
        END;

    { We keep track of which rectangle the user last clicked in, so we can
      do double-click actions if he clicks in it twice within DblTime.  Here
      we initialize that to -1 so it can't possibly succeed on his first click. }

    gLastRectClicked := -1; { make sure the double-click test fails the first
                              time }
END; { InitializeApplication }

{$S Main}
(******************************************************************************
*
* Public: RemoveAppAEHandlers
*
* This shell function is called by Sample.p after it removes its Apple
* Event handlers.  We'd remove any application-specific event handlers here,
* but we don't have any so it's an empty procedure.
*
******************************************************************************)

PROCEDURE RemoveAppAEHandlers;

BEGIN
END; { RemoveAppAEHandlers }

{$S Main}
(******************************************************************************
*
* Public: TerminateApplication
*
* Sample.p calls TerminateApplication from within Terminate, to give this
* unit a chance to shut down anything specific it has going without having
* to put it in the main code.  We don't really have anything to do, so
* we simply return TRUE, saying "Yeah, we're ready to quit."
*
* If we had a Handle for the preferences record, for example, this is where
* we'd dispose it.
*
******************************************************************************)

FUNCTION TerminateApplication: BOOLEAN;

BEGIN
    TerminateApplication := TRUE;
END; { TerminateApplication }

{$S Main}
(******************************************************************************
*
* Public: ChangeCircleColor
*
* This routine presents the Macintosh color Picker dialog on the deepest
* screen (by setting the Point to (-1, -1)) and, if the user picks a new
* color, stores that color in the circle record.  We start with the circle's
* existing color.
*
******************************************************************************)

PROCEDURE ChangeCircleColor(theCircle: CircleRecPtr);

VAR
    tempRGB: RGBColor;                { the color we get from the color picker }
    where: Point;                    { where to place the color picker dialog }
    promptStr: Str255;                { the prompt String for the dialog }

BEGIN
    where.h := -1;
    where.v := -1;                     { Let the color Picker center this nicely }
    GetIndString(promptStr, rMiscStrings, kPickColor);        { get the prompt }

    IF GetColor(where, promptStr, theCircle^.circleColor, tempRGB) THEN
        theCircle^.circleColor := tempRGB;
END; { ChangeCircleColor }

{$S Main}
(******************************************************************************
*
* Public: ChangeCircleFont
*
* This was actually one of the first accessor functions I wound up adding,
* because it became difficult to manipulate a circle record from another
* twisted, long-since-improved portion of the code.  It reminded me how
* accessor functions are generally good things, and so they now exist for
* most CircleRec members.
*
* This one stores a new font name in the given circle record.
*
******************************************************************************)

PROCEDURE ChangeCircleFont(theCircle: CircleRecPtr; theNewFontName: Str255);

BEGIN
    theCircle^.circleFont := theNewFontName;
END; { ChangeCircleFont }

{$S Main}
(******************************************************************************
*
* Public: ChangeCircleTxSize
*
* This routine sets the given circle's circleTxSize field to theNewSize.
*
******************************************************************************)

PROCEDURE ChangeCircleTxSize(theCircle: CircleRecPtr; theNewSize: INTEGER);

BEGIN
    theCircle^.circleTxSize := theNewSize;
END; { ChangeCircleTxSize }

{$S Main}
(******************************************************************************
*
* Public: ChangeCircleText
*
* This routine sets the given circle's circleText field to theNewText.
*
******************************************************************************)

PROCEDURE ChangeCircleText(theCircle: CircleRecPtr; theNewText: Str255);

BEGIN
    theCircle^.circleText := theNewText;
END; { ChangeCircleText }

{$S Main}
(******************************************************************************
*
* Public: ChangeCircleStyle
*
* This routine sets the given circle's circleFace field to theNewStyle.
*
******************************************************************************)

PROCEDURE ChangeCircleStyle(theCircle: CircleRecPtr; theNewStyle: Style);

BEGIN
    theCircle^.circleFace := theNewStyle;
END; { ChangeCircleStyle }

{$S Main}
(******************************************************************************
*
* private: DrawLightParts
*
* You'd think drawing simple filled colored circles with text in them would
* be a pretty simple thing to do.  Ha.  Ye of little paranoia.
*
* If we have color QuickDraw, an "on" light is drawn with a colored
* circle, a black frame and text.  If the background color is darker than 50%
* gray, the text is white, otherwise the text is black.  "Off" lights
* are black framed circles with white interiors and no text.
*
* If we don't have color QuickDraw, or if the monitor is one or two-bit deep,
* an "on" light is white text on a black background.  "Off" lights are black
* framed circles with white interiors and no text.
*
* in either case, it changes if the window isn't active.  "On" lights in
* inactive windows are a black framed circle with a white background and black
* text.  "Off" lights aren't drawn at all.
*
* The text is centered in the circle -- the horizontal center of the text
* is the center of the circle.  The vertical pen location before drawing
* the text needs to be set so that the Line going through the center of
* the text also goes through the circle's center.  Normally, the vertical
* position before drawing text is the character's baseline, so we have to
* Move to the vertical center of the circle, and then Move then pen down
* by half of the fontHeight.  This is tricky, so please look at the font
* pictures in Inside Macintosh and play with it if you don't understand
* why this works.
*
* We only draw text if the Point size is greater than zero (if you pass zero
* to TextSize, you get the system default, which is usually 12, and that's
* not very intuitive for interactive situations like the Modify Circle
* dialog), if there are characters to draw, and if the light is on, to
* avoid a mess of computations.
*
* Once we have everything ready, we still can't tell if the String we're
* about to draw fits into the circle or not.  Imagine the String being the
* boundary rectangle for the text, and it being exactly as wide as the circle
* is at its widest Point.  StringWidth would say "this isn't too wide,"
* but the circle gets narrower above and below the middle, so the top and
* bottom of the rectangle would be outside the circle.  The only way
* to know exactly which characters would fall outside the circle would be
* to know how QuickDraw draws a circle (so we can compare), or to see
* if all the text falls within a circular Region.  If we're going to
* do that, we might as well just clip to a circular Region, so we do.
*
* The drawback is that non-rectangular clipping regions don't work on
* PostScript printers.  If the text would exceed the circle's boundaries,
* PostScript printers only clip to the rectangular bounding box of the
* Region, not the circular Region itself.  There's no way to layer this
* so that it does what we want on the screen and on PostScript printers
* before QuickDraw GX, where clipping to an arbitrary shape works on
* all printer types.
*
* This routine is usually called from another routine -- either DeviceLoop
* or DeviceLoopSim (SampleUtilities.p), which call it separately for each
* monitor the given light intersects.  The depth parameter tells us how
* deep the monitor is.  If it's zero, we called it directly and assume
* there's no color QuickDraw.  We don't use the flags passed to us by
* those routines, nor do we use the targetDevice.  The final parameter
* is a LightConditionsPtr, which tells us the CircleRec and the state
* of the light (is it on, is it active, are we printing).
*
* Since this routine is called from elsewhere, it saves and restores
* values it changes in the current GrafPort.  Macintosh Technical Note
* "Old-Style colors" recommends directly saving and restoring values
* in the GrafPort since we can't get RGB colors from it, so we do that.
* If 32-Bit QuickDraw is around, we call PortChanged after restoring the
* old values so any accelerator card can figure out we mucked directly
* with the GrafPort structure.
*
******************************************************************************)

PROCEDURE DrawLightParts(depth: INTEGER; flags: INTEGER; targetDevice: GDHandle;
                         myLight: LightConditionsPtr);

VAR
    oldForeColor,                    { port's ForeColor for restoring later }
    oldBackColor,                    { port's BackColor for restoring later }
    colorTemp: LONGINT;                { normalized "brightness" value for color }
    rectWidth,                        { width of this circle's rectangle }
    rectHeight,                        { height of this circle's rectangle }
    fontHeight,                        { height of the font not including leading }
    stringBtm,                        { Y position for pen before drawing text }
    stringLeft,                        { X position for pen before drawing text }
    oldTxMode,                        { port's txMode for restoring later }
    oldTxFont,                        { port's txFont for restoring later }
    oldTxSize,                        { port's txSize for restoring later }
    theFont,                        { family number of this circle's font }
    frameColor,                        { old-style color for frame of circle }
    ourTextMode: INTEGER;            { mode we draw the circle's text with }
    fontStuff: FontInfo;            { record with info about circle's font }
    ourPort: GrafPtr;                { the current GrafPort }
    theOldClip,                        { the port's old clipRgn, for restoring }
    ourCircleRgn,                    { circular Region for this circle }
    newClipRgn: RgnHandle;            { new clipRgn for clipping }
    useColor: BOOLEAN;                { TRUE if we draw with color }

BEGIN

    { First, check to see if we're going to draw anything.  Bail out quickly
      if everything would be clipped out.  Make a Region that includes this
      port's clipRgn and visRgn and see if our circle's rectangle intersects
      it.  If it doesn't, skip the rest of this routine. }

    ourCircleRgn := NewRgn;
    GetPort(ourPort);
    SectRgn(ourPort^.clipRgn, ourPort^.visRgn, ourCircleRgn);
    IF RectInRgn(myLight^.theCircle^.circleRect, ourCircleRgn) OR
       (myLight^.arePrinting) THEN
        WITH myLight^.theCircle^ DO
            BEGIN

                { If we're passed a depth of zero, we need to check to see
                  if this is a CGrafPort (rowBytes is negative in a CGrafPort).
                  We call this routine directly for printing, so if we don't
                  do this, we won't get color output on color printers.
                  If depth is not zero, use color if we're four bits deep
                  or deeper. }

                IF depth = 0 THEN
                    useColor := (ourPort^.portBits.rowBytes < 0)
                ELSE
                    useColor := (depth > 2);

                IF useColor THEN
                    BEGIN

                        { The RGB values for the color are signed numbers,
                          but to do our simple test, we want to average them
                          together and see if the average is greater than
                          32768.  If it is, it's a light color and the text
                          will be black -- otherwise it's a dark color and
                          the text will be white.  To "normalize" the signed
                          values, we add $10000 to them if they're negative.
                          Then we average them together. }

                        colorTemp := circleColor.red + ($10000 *
                                     ord(circleColor.red < 0));
                        colorTemp := colorTemp + circleColor.blue + ($10000 *
                                     ord(circleColor.blue < 0));
                        colorTemp := colorTemp + circleColor.green +
                                     ($10000 * ord(circleColor.green < 0));
                        colorTemp := colorTemp DIV 3;
                    END;

                { Set the frame for the circle -- black if the light is on or
                  if it's off in an active window, white otherwise so it
                  doesn't show up. }

                IF myLight^.itsOn OR myLight^.itsActive THEN
                    frameColor := blackColor
                ELSE
                    frameColor := whiteColor;

                { Save the curent values for these fields so we can restore
                  them later }

                oldForeColor := thePort^.fgColor;
                oldBackColor := thePort^.bkColor;
                oldTxMode := thePort^.txMode;
                oldTxFont := thePort^.txFont;
                oldTxSize := thePort^.txSize;

                { Now set the port's ForeColor in preparation for drawing
                  the circle.  If the light is "on" and in an active window,
                  then use RGBForeColor if we can use color and if we have
                  color QuickDraw.  Otherwise, the circle is black.

                  If the light isn't "on" or in an active window, we set
                  the pen mode to patBic instead to get QuickDraw to
                  erase the circle when we paint it.  This works better than
                  ForeColor(whiteColor) for printing, especially with LaserWriter
                  driver 7.x, where all colors, even white, lead to black. }

                IF myLight^.itsActive AND myLight^.itsOn THEN
                    IF (useColor) AND gHasColorQD THEN
                        RGBForeColor(circleColor)
                    ELSE
                        ForeColor(blackColor)
                ELSE
                    PenMode(patBic);

                { Draw the circle and its frame, after all this setup }

                PaintOval(circleRect);
                PenMode(patCopy);
                ForeColor(frameColor);
                FrameOval(circleRect);


                { Now prepare to draw the text in the text color on the
                  circle's colored background, centered.  Avoid drawing if
                  the size or length is zero, and if the light isn't "on."

                  We change the pen mode to do black or white drawing.  If
                  we use color, if the circle color is "light" (colorTemp
                  > 32768), or if the light is in an inactive window, the
                  text is black.  Otherwise, we use text mode srcBic to
                  clear the pixels instead of setting them, producing
                  white text.  Again, this works better with printing.
                  Otherwise, we use srcOr to draw the text in black, as
                  Inside Macintosh recommends, in black. }

                ForeColor(blackColor);
                IF ((myLight^.itsOn) AND (length(circleText) > 0) AND
                   (circleTxSize > 0)) THEN
                    BEGIN
                        IF ((useColor) AND (colorTemp > 32768)) OR
                           NOT myLight^.itsActive THEN
                            ourTextMode := srcOr
                        ELSE
                            BEGIN
                                ForeColor(whiteColor);
                                ourTextMode := srcBic
                            END;

                        { Get the width and height of the rectangle, find
                          the font number for the circle, set the text
                          drawing parameters appropriately for the circle }

                        rectWidth := abs(circleRect.right -
                                     circleRect.left);
                        rectHeight := abs(circleRect.bottom -
                                          circleRect.top);

                        GetFNum(circleFont, theFont); { Turn the name into a
                                                       font number }
                        TextFont(theFont); { and install that font into
                                            thePort }
                        TextSize(circleTxSize); { with the given size }
                        TextFace(circleFace);

                        { Get the font height.  Find the halfway Point of the
                          circle by adding half the circle's height to the
                          circle's top.  Then add half the font's height and
                          subtract the baseline to find where to draw the
                          text.  Horizontally center the text by moving to
                          the left edge of the circle, plus half the width
                          of the circle, minus half the width of the String. }

                        GetFontInfo(fontStuff);
                        fontHeight := fontStuff.ascent + fontStuff.descent;
                        stringBtm := (rectHeight DIV 2) + (fontHeight DIV
                                     2) + circleRect.top - fontStuff.
                                     descent;
                        stringLeft := circleRect.left + ((rectWidth DIV 2) -
                                      (StringWidth(circleText) DIV 2));
                        MoveTo(stringLeft, stringBtm);

                        TextMode(ourTextMode);

                        { Create a circular clipping Region so the text won't
                          exceed the circle's boundaries on-screen or to most
                          printers.  Save and restore the old clipping Region. }

                        theOldClip := NewRgn;
                        GetClip(theOldClip);

                        newClipRgn := NewRgn;
                        OpenRgn;
                        FrameOval(circleRect);
                        CloseRgn(newClipRgn);
                        SetClip(newClipRgn);

                        DrawString(circleText);        { draw the text!  yay! }

                        SetClip(theOldClip);

                        DisposeRgn(theOldClip);
                        DisposeRgn(newClipRgn);

                    END;    { IF we should draw text THEN draw it }

                { Now back out of all this.  Use trap calls to restore the
                  text parameters and tell 32-Bit QuickDraw we did some
                  mucking with the port directly.  Restore the old colors
                  directly based on the Technical Note's recommendation. }

                thePort^.fgColor := oldForeColor;
                thePort^.bkColor := oldBackColor;
                TextMode(oldTxMode);
                TextFont(oldTxFont);
                TextSize(oldTxSize);
                IF gHas32BitQD THEN
                    PortChanged(ourPort);

            END;                      { with myLight^.theCircle^ }
    DisposeRgn(ourCircleRgn);
END; { DrawLightParts }

{$S Main}
(******************************************************************************
*
* private: MyDeviceLoop
*
* This is a simple redeclaration of DeviceLoop, using a LONGINT as the last
* parameter instead of a set of DeviceLoopFlags.  THINK Pascal 4.0.2 may
* generate incorrect code for passing the DeviceLoopFlags parameter, so we
* simply make it a LONGINT and use it that way.
*
******************************************************************************)

PROCEDURE MyDeviceLoop(drawingRgn: RgnHandle; DrawingRoutine: Ptr;
                       userData: LONGINT; flags: LONGINT);
    INLINE $ABCA;

{$S Main}
(******************************************************************************
*
* Public: DrawLight
*
* DrawLight draws the light specified by LightConditions.  If DeviceLoop
* is available, it calls the trap.  If DeviceLoop isn't present but
* color QuickDraw is, it calls DeviceLoopSim.  If neither is present, or
* if we're printing, it calls DrawLightParts directly with a depth of zero.
*
******************************************************************************)

PROCEDURE DrawLight(myLight: LightConditions);

VAR
    drawingRgn: RgnHandle;            { Region of area to draw }

BEGIN
    drawingRgn := NewRgn;
    RectRgn(drawingRgn, myLight.theCircle^.circleRect);
                                    { tell our routines where to draw }

    IF (gHasDeviceLoop AND NOT myLight.arePrinting) THEN
        MyDeviceLoop(drawingRgn, @DrawLightParts, LONGINT(@myLight), 0)
    ELSE IF (gHasColorQD AND NOT myLight.arePrinting) THEN
        DeviceLoopSim(drawingRgn, @DrawLightParts, LONGINT(@myLight), 0)
    ELSE
        DrawLightParts(0, 0, NIL, @myLight); { depth of zero is special, no
                                              flags, no device }

    DisposeRgn(drawingRgn);            { dispose of the Region we made }

END; { DrawLight }

{$S Main}
(******************************************************************************
*
* Public: DrawDocument
*
* This routine draws a document into a given GrafPort.  If printing is TRUE,
* we assume we're printing and don't erase the portRect first.  If isActive
* is TRUE, we draw as if this is an active window.  Both flags are also
* passed to DrawLight so the lights get drawn the right way.
*
* We don't erase when printing because it's not necessary, and on some
* printers it's a slow operation.
*
******************************************************************************)

PROCEDURE DrawDocument(theDoc: DocumentPtr; drawingPort: GrafPtr; printing,
                       isActive: BOOLEAN);

VAR
    counter: INTEGER;                { loop counter variable }
    theLight: LightConditions;        { state of each light to draw }

BEGIN
    SetPort(drawingPort);            { use the specified port }
    IF NOT printing THEN
        EraseRect(drawingPort^.portRect);
    FOR counter := 1 TO theDoc^.numCircles DO
        BEGIN
            theLight.itsOn := (counter = theDoc^.activeCircle); { is it on? }
            theLight.itsActive := isActive;                        { is active? }
            theLight.theCircle := @theDoc^.circleArray[counter];{ CircleRec? }
            theLight.arePrinting := printing;                    { printing? }
            DrawLight(theLight);
        END;
END; { DrawDocument }

{$S Main}
(******************************************************************************
*
* Public: DrawWindow
*
* This is a lot like DrawDocument, except it takes a window for those routines
* (like those in Sample.p that mainly deal with windows) who don't know our
* document structure.  If the drawingPort is NIL, we draw to the window
* passed, otherwise we draw to the second port.  We can therefore redirect
* if we have a window pointer (in this routine) or if we only have a document
* pointer (in DrawDocument).
*
*
******************************************************************************)

PROCEDURE DrawWindow(window: WindowPtr; drawingPort: GrafPtr; printing: BOOLEAN;
                     isActive: BOOLEAN);

VAR
    ourPort: GrafPtr;            { the port to draw into }

BEGIN
    IF drawingPort = NIL THEN
        ourPort := window
    ELSE
        ourPort := drawingPort;

    DrawDocument(DocumentPtr(GetWRefCon(window)), ourPort, printing, isActive);

END; { DrawWindow }

{$S Main}
(******************************************************************************
*
* Public: MakeDocumentPicture
*
* This routine draws a document into a QuickDraw PICT and returns the Handle
* to it.  We use this in printing, and currently if someone selects "copy"
* from the "Edit" menu.  We open a new GrafPort or CGrafPort, set to it,
* open a Picture, draw the document and close it all down.
*
******************************************************************************)

FUNCTION MakeDocumentPicture(theDoc: DocumentPtr): PicHandle;

VAR
    myPort: GrafPort;            { the actual port we'll use }
    theSize: Point;                { the size of the document }

BEGIN
    IF gHasColorQD THEN
        OpenCPort(CGrafPtr(@myPort))    { use color if we can }
    ELSE
        OpenPort(@myPort);                { but life goes on if we can't }

    SetPort(@myPort);
    GetDocumentDrawingSize(theDoc, theSize);
    PortSize(theSize.h, theSize.v);

    MakeDocumentPicture := OpenPicture(myPort.portRect);
    DrawDocument(theDoc, @myPort, TRUE, TRUE); { pretend we're printing to
                                                 avoid DeviceLoop }
    ClosePicture;
    ClosePort(@myPort);
END; { MakeDocumentPicture }

{$S Main}
(******************************************************************************
*
* private: FindContentCircle
*
* We use this routine to tell us which circle, if any, a given Point is over
* in a window.  We return zero if the Point is not inside a circle's rectangle.
* We use this for hit-testing, so clicking in a circle can turn it "on."
*
* The Point must be in global coordinates, like a mouse position in an
* Event record.
*
******************************************************************************)

FUNCTION FindContentCircle(window: WindowPtr; where: Point): INTEGER;

VAR
    theDoc: DocumentPtr;                { the document for the window }
    counter: INTEGER;                    { loop variable counter }

BEGIN
    FindContentCircle := 0;                { assume no circle found }
    SetPort(window);
    theDoc := DocumentPtr(GetWRefCon(window));
    GlobalToLocal(where);                { change to local coordinates }
    FOR counter := 1 TO theDoc^.numCircles DO
        BEGIN
            IF PtInRect(where, theDoc^.circleArray[counter].circleRect) THEN
                FindContentCircle := counter;
        END;
END; { FindContentCircle }

{$S Main}
(******************************************************************************
*
* Public: ChangeCircleOptions
*
* This routine make sure that kDialogMemorySize bytes are available and,
* if they are, conducts the "Modify Circle" dialog.  We do this here because
* the routine is in another segment, and if the segment doesn't have enough
* memory to load, we go boom.
*
******************************************************************************)

FUNCTION ChangeCircleOptions(VAR circle: CircleRec): BOOLEAN;

VAR
    myHandle: Handle;                    { the Handle to test memory with }

BEGIN
    ChangeCircleOptions := FALSE;
    myHandle := NewHandle(kDialogMemorySize);
    DisposeHandle(myHandle);
    IF myHandle = NIL THEN
        AlertUser(rNoMemoryForOperation)
    ELSE IF OKToInteract THEN
        ChangeCircleOptions := DoCircleOptions(circle);
END; { ChangeCircleOptions }

{$S Main}
(******************************************************************************
*
* Public: DoContentClick
*
* Sample.p calls DoContentClick when a mouse-down even occurs in the content
* of a window.  If we had things other than circles, we might want to call
* FindControl, TEClick, etc. to further process this click.
*
* We call FindContentCircle to figure out which circle they clicked in, if
* any.  If they did, we make that circle active.  If it's the same
* window they clicked in last time, and the same rectangle, and no more
* than GetDblTime ticks have elapsed since the click, this is a double-click,
* so we call ChangeCircleOptions to modify the circle, invalidating the
* circle if the user accepted any changes.
*
* Then we store the current tick count, window pointer and rectangle number
* in global variables so we can watch for a double-click next time.
*
******************************************************************************)

PROCEDURE DoContentClick(window: WindowPtr; event: EventRecord);

{This is called when a mouse-down event occurs in the content of a window.}
{ Other applications might want to call FindControl, TEClick, etc., to}
{ further process the click.}

VAR
    theDoc: DocumentPtr;
    localPoint: Point;
    whichRect: INTEGER;

BEGIN
    whichRect := FindContentCircle(window, event.where);
    IF whichRect <> 0 THEN
        BEGIN
            theDoc := DocumentPtr(GetWRefCon(window));
            ChangeActiveCircle(whichRect, theDoc);

            IF (gLastRectClicked = whichRect) AND (gLastWindowClicked =
               window) AND (event.when - gLastClickedTime < GetDblTime) THEN
                IF ChangeCircleOptions(theDoc^.circleArray[whichRect]) THEN
                    SetDocumentDirtyFlag(theDoc, kDocumentDirty);

            gLastClickedTime := event.when;
            gLastWindowClicked := window;
            gLastRectClicked := whichRect;
        END;

END; { DoContentClick }

{$S Main}
(******************************************************************************
*
* Public: DoHelp
*
* We call DoHelp on a mouse-moved event if balloon help is on and if the
* mouse is over the frontmost window.
*
* If FindContentCircle says the mouse is over one of the circles, we take
* that circle's rectangle, change it to global coordinates (by calling
* LocalToGlobal on the topLeft and botRight points), set the "tip" Point
* to the center of that rectangle and set the 'STR#' index of our help
* balloon String to either the "active circle" help or the "inactive circle"
* help.  Then we show the balloon.  The new mouseRgn, returned in the
* parameter, is that circle's rectangle.  If the mouse moves outside
* that rectangle, we'll get called again.
*
* If we're not over a circle, we're still in the window, so we set the
* Region to the window's content Region minus all the circles' rectangles.
* in that case, we expect mouseRgn to already be the window's content
* Region, because that's what the cursorRgn for WaitNextEvent would be
* if balloon help wasn't on.
*
******************************************************************************)

PROCEDURE DoHelp(where: Point; mouseRgn: RgnHandle);

VAR
    myErr: OSErr;                        { errors from system routines }
    tip: Point;                            { Point for tip of balloon }
    theDoc: DocumentPtr;                { the document for the front window }
    window: WindowPtr;                    { the front window }
    whichRect,                            { the Rect the mouse is over }
    rectCount: INTEGER;                    { loop counter variable }
    newMouseRgn: RgnHandle;                { new Region to calculate }
    hotRect: Rect;                        { show help while mouse is in this Rect }
    helpMsg: HMMessageRecord;            { The help message record we use }

BEGIN
    window := FrontWindow;
    theDoc := DocumentPtr(GetWRefCon(window));
    whichRect := FindContentCircle(window, where);
    IF whichRect <> 0 THEN
        BEGIN
            helpMsg.hmmHelpType := khmmStringRes;
            helpMsg.hmmStringRes.hmmResID := rBalloonHelpStringID;

            hotRect := theDoc^.circleArray[whichRect].circleRect;
            LocalToGlobal(hotRect.topLeft);
            LocalToGlobal(hotRect.botRight);

            WITH hotRect DO
                SetPt(tip, ((right - left) DIV 2) + left, ((bottom - top) DIV
                      2) + top);

            IF whichRect = theDoc^.activeCircle THEN
                helpMsg.hmmStringRes.hmmIndex := kActiveCircleBalloonString
            ELSE
                helpMsg.hmmStringRes.hmmIndex := kInactiveCircleBalloonString;

            myErr := HMShowBalloon(helpMsg, tip, @hotRect, NIL, 0, 0, 0);

            { return the mouseRgn as a copy of the hotRect }

            RectRgn(mouseRgn, hotRect);

        END
    ELSE
        BEGIN
            { it's not over any circle, so set the Region to the content Region
                 minus all rectangles }

            newMouseRgn := NewRgn; { mouseRgn is already the window's content
                                       Region }
            OpenRgn;
            FOR rectCount := 1 TO theDoc^.numCircles DO
                BEGIN

                    { we use hotRect here as a temporary variable }

                    hotRect := theDoc^.circleArray[rectCount].circleRect;
                    LocalToGlobal(hotRect.topLeft);
                    LocalToGlobal(hotRect.botRight);
                    FrameRect(hotRect); { add it to the Region }
                END;
            CloseRgn(newMouseRgn);

            { subtract the Region with all the rects from the original Region,
              and put the result into mouseRgn. }

            DiffRgn(mouseRgn, newMouseRgn, mouseRgn);

        END; { whichRect <> 0 }
END; { DoHelp }

{$S Main}
(******************************************************************************
*
* Public: DoRevert
*
* Sample.p calls DoRevert when the user picks the "Revert..." menu item.
* We ask the user if he really wants to throw away changes to the document,
* and if he says "Sure," we do it.  We close the existing file and re-read
* it from disk, redrawing the whole thing.  We return TRUE if there were
* no errors in this operation.
*
******************************************************************************)

FUNCTION DoRevert(theWindow: WindowPtr): BOOLEAN;

VAR
    theDoc: DocumentPtr;                { this window's document }
    success: BOOLEAN;                    { result of GetDocumentFromFile }
    myErr: OSErr;                        { error from system calls }

BEGIN
    myErr := noErr;
    success := TRUE;                    { assume success }
    theDoc := DocumentPtr(GetWRefCon(theWindow));
    ParamText(theDoc^.ourFile.name, '', '', '');
    IF AskUser(rReallyRevert) THEN
        BEGIN
            myErr := FSClose(theDoc^.ourFileRefNum);
            IF myErr = noErr THEN
                BEGIN
                    success := GetDocumentFromFile(@theDoc^.ourFile,
                                                   theDoc);
                    SetPort(theWindow);
                    InvalRect(theWindow^.portRect);
                END
            ELSE
                HandleFileError(myErr, theDoc^.ourFile.name);
        END;

    DoRevert := ((myErr = noErr) AND success);

END; { DoRevert }